home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / VTOOLS / VTKEY.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-20  |  3KB  |  132 lines
  1. UNIT VTKEY;
  2.  
  3. INTERFACE
  4.  Var Key,Key1 : Byte;
  5.      StatusBits : Word Absolute $0040:$0017;
  6.  
  7. Procedure GetKey(Var AscCode,PosCode : Byte);
  8. Procedure KeyPressed(Var AscCode,PosCode : Byte);
  9. Procedure FlushKBD;
  10.  
  11. Function LeftShiftPressed : Boolean;
  12. Function RightShiftPressed : Boolean;
  13. Function ShiftPressed : Boolean;
  14. Function RightAltPressed : Boolean;
  15. Function LeftAltPressed : Boolean;
  16. Function AltPressed : Boolean;
  17. Function RightCtrlPressed : Boolean;
  18. Function LeftCtrlPressed : Boolean;
  19. Function CtrlPressed : Boolean;
  20. Function  CapsOn : Boolean;
  21. Function  NumOn : Boolean;
  22. Function  ScrollOn : Boolean;
  23.  
  24. Procedure SetCaps (Stat : Boolean);
  25. Procedure SetNum (Stat : Boolean);
  26. Procedure SetScroll (Stat : Boolean);
  27. IMPLEMENTATION
  28.  procedure Getkey(var AscCode,PosCode : Byte); assembler;
  29.    asm
  30.    PUSH DS   { Save the DS & ES }
  31.    PUSH ES
  32.    MOV AH,0h { Attach the 0 function | Get next key or wait for key }
  33.    INT 16h
  34.    LES DI,AscCode { Load the ASCII code }
  35.     STOSB
  36.    MOV AL,AH      { Load Position code }
  37.    LES DI,PosCode
  38.     STOSB
  39.    POP ES         { Restore old ES & DS }
  40.    POP DS
  41.   end;
  42.  
  43.  Procedure KeyPressed(var AscCode,PosCode : Byte); assembler;
  44.  asm
  45.   PUSH DS        { Save  DS & ES }
  46.   PUSH ES
  47.   MOV AH,01h     { Attach the 01 function | check if have a key into buufer }
  48.   INT 16h
  49.   JNZ @LoadData  { ZeroFlag is set to 1 if have key }
  50.   MOV AX,0       { Else return 0}
  51.  @LoadData:
  52.    LES DI,AscCode { Load ASCII code | AL - ASCII Code }
  53.    STOSB
  54.    MOV AL,AH      { Load Position code | AH - Position code }
  55.    LES DI,PosCode
  56.    STOSB
  57.    POP ES         { Restore Old ES & BP }
  58.    POP DS
  59.  End;
  60. Procedure FlushKBD;
  61.  Var a,b : Byte;
  62. Begin
  63.  Repeat GetKey(a,b); Until a = 0;
  64. End;
  65.  
  66. Function LeftShiftPressed : Boolean;
  67. Begin
  68.  leftShiftPressed := (StatusBits and 2) <> 0;
  69. End;
  70. Function RightShiftPressed : Boolean;
  71. Begin
  72.  RightShiftPressed := (StatusBits and 1) <> 0;
  73. End;
  74.  
  75. Function ShiftPressed : Boolean;
  76. Begin
  77.  ShiftPressed := ((StatusBits And 1) <> 0) Or ((StatusBits and 2) <> 0);
  78. End;
  79. Function RightAltPressed : Boolean;
  80. Begin
  81.  RightAltPressed := (StatusBits and 8) <> 0;
  82. End;
  83. Function LeftAltPressed : Boolean;
  84. Begin
  85.  LeftAltPressed := (StatusBits and 520) <> 0;
  86. End;
  87. Function AltPressed : Boolean;
  88. Begin
  89.  AltPressed:= ((StatusBits and 520) <> 0) Or ((StatusBits and 8) <> 0);
  90. End;
  91. Function RightCtrlPressed : Boolean;
  92. Begin
  93. RightCtrlPressed := (StatusBits and 4) <> 0;
  94. End;
  95. Function LeftCtrlPressed : Boolean;
  96. Begin
  97.  LeftCtrlPressed := (StatusBits and 260) <> 0;
  98. End;
  99. Function CtrlPressed : Boolean;
  100. Begin
  101.  CtrlPressed := ((StatusBits and 260) <> 0) Or ((StatusBits and 4) <> 0);
  102. End;
  103. Function  CapsOn : Boolean;
  104. Begin
  105.  CapsOn := (StatusBits and 64) <> 0;
  106. End;
  107. Function  NumOn : Boolean;
  108. Begin
  109.  NumOn := (StatusBits and 32) <> 0;
  110. End;
  111. Function ScrollOn : Boolean;
  112. Begin
  113.  ScrollOn := (StatusBits and 16) <> 0;
  114. End;
  115. Procedure SetCaps (Stat : Boolean);
  116. Begin
  117.  If Stat Then StatusBits := (StatusBits Or 64)
  118.  Else StatusBits := (StatusBits And 191);
  119. End;
  120. Procedure SetNum (Stat : Boolean);
  121. Begin
  122.  If Stat Then StatusBits := (StatusBits Or 32)
  123.  Else StatusBits := (StatusBits And 223);
  124. End;
  125. Procedure SetScroll (Stat : Boolean);
  126. Begin
  127.  If Stat Then StatusBits := (StatusBits Or 16)
  128.  Else StatusBits := (StatusBits And 239);
  129. End;
  130. BEGIN
  131. END.
  132.